perm filename GEOMES.HDR[SAI,BGB]1 blob
sn#029712 filedate 1973-03-16 generic text, type T, neo UTF8
00100 COMMENT LOAD GEOMES AND FRIENDS;
00200
00300 REQUIRE "GEOMES.REL[GEO,BGB]" LOAD_MODULE;
00400 REQUIRE "WINGS.REL[GEO,BGB]" LOAD_MODULE;
00500 REQUIRE "EULER.REL[GEO,BGB]" LOAD_MODULE;
00600 REQUIRE "BIN.REL[GEO,BGB]" LOAD_MODULE;
00700 REQUIRE "EUCLID.REL[GEO,BGB]" LOAD_MODULE;
00800 REQUIRE "VIEWER.REL[GEO,BGB]" LOAD_MODULE;
00900 REQUIRE "OCCULT.REL[GEO,BGB]" LOAD_MODULE;
01000 REQUIRE "LS.REL[GEO,BGB]" LOAD_MODULE;
01100 REQUIRE "IO.REL[GEO,BGB]" LOAD_MODULE;
01200
01300 COMMENT THE MACRO XCALL(NAME,ARGS);
01400 DEFINE XCALL(NAME,ARGS)=
01500 ⊂ DEFINE _NAME="_"&"NAME";
01600 SIMPLE INTEGER PROCEDURE _NAME ARGS;
01700 BEGIN
01800 EXTERNAL SIMPLE INTEGER PROCEDURE NAME;
01900 START_CODE
02000 MOVEM '12,BGB12;
02100 MOVEM '16,BGB16;
02200 POP '17,BGBRET;
02300 PUSHJ '17,NAME;
02400 MOVE '12,BGB12;
02500 MOVE '16,BGB16;
02600 JRST @BGBRET;
02700 END;
02800 END;
02900 DEFINE NAME="_"&"NAME"
03000 ⊃;
03100
03200 COMMENT DECLARATIONS FOR GEOMES PROCEDURES;
03300
03400 INTEGER BGB12,BGB16,BGBRET;
03500
03600 XCALL(⊂MKNODE⊃,⊂(INTEGER TYP)⊃);
03700 XCALL(⊂KLNODE⊃,⊂(INTEGER NOD)⊃);
03800
03900 DEFINE XWC(V)=⊂MEMORY[V-3,REAL]⊃;
04000 DEFINE YWC(V)=⊂MEMORY[V-2,REAL]⊃;
04100 DEFINE ZWC(V)=⊂MEMORY[V-1,REAL]⊃;
04200
04300 DEFINE XPP(V)=⊂MEMORY[V+4,REAL]⊃;
04400 DEFINE YPP(V)=⊂MEMORY[V+5,REAL]⊃;
04500 DEFINE ZPP(V)=⊂MEMORY[V+6,REAL]⊃;
04600
04700 DEFINE H1(X)=⊂ (X LSH -18)⊃;
04800 DEFINE H2(X)=⊂ (X LAND '777777)⊃;
04900
05000 DEFINE NFACE(E)=⊂H1(MEMORY[E+1])⊃;
05100 DEFINE PFACE(E)=⊂H2(MEMORY[E+1])⊃;
05200 DEFINE NED(E)=⊂H1(MEMORY[E+2])⊃;
05300 DEFINE PED(E)=⊂H2(MEMORY[E+2])⊃;
05400 DEFINE NVT(E)=⊂H1(MEMORY[E+3])⊃;
05500 DEFINE PVT(E)=⊂H2(MEMORY[E+3])⊃;
05600
00100 COMMENT WINGS;
00200
00300 XCALL(⊂MKWORLD⊃,⊂⊃);
00400 XCALL(⊂MKWINDOW⊃,⊂⊃);
00500 XCALL(⊂MKCAMERA⊃,⊂⊃);
00600 XCALL(⊂MKLOCOR⊃,⊂⊃);
00700
00800 XCALL(⊂MKB⊃,⊂(INTEGER WORLD)⊃);
00900 XCALL(⊂KLB⊃,⊂(INTEGER BNEW)⊃);
01000 XCALL(⊂KLBFEV⊃,⊂(INTEGER Q)⊃);
01100
01200 XCALL(⊂MKF⊃,⊂(INTEGER B)⊃);
01300 XCALL(⊂MKE⊃,⊂(INTEGER B)⊃);
01400 XCALL(⊂MKV⊃,⊂(INTEGER B)⊃);
01500
01600 XCALL(⊂WING⊃,⊂(INTEGER E1,E2)⊃);
01700 XCALL(⊂LINKED⊃,⊂(INTEGER Q1,Q2)⊃);
01800
01900 XCALL(⊂ECW⊃,⊂(INTEGER Q1,Q2)⊃);
02000 XCALL(⊂ECCW⊃,⊂(INTEGER Q1,Q2)⊃);
02100 XCALL(⊂OTHER⊃,⊂(INTEGER Q1,Q2)⊃);
02200 XCALL(⊂OTHER_⊃,⊂(INTEGER Q,E,X)⊃);
02300
02400 XCALL(⊂BGET⊃,⊂(INTEGER Q)⊃);
02500 XCALL(⊂BDET⊃,⊂(INTEGER Q1,Q2)⊃);
02600 XCALL(⊂BATT⊃,⊂(INTEGER Q1,Q2)⊃);
02700
02800 XCALL(⊂VCW⊃,⊂(INTEGER E,F)⊃);
02900 XCALL(⊂VCCW⊃,⊂(INTEGER E,F)⊃);
03000 XCALL(⊂FCW⊃,⊂(INTEGER E,V)⊃);
03100 XCALL(⊂FCCW⊃,⊂(INTEGER E,V)⊃);
03200
00100 COMMENT EULER;
00200
00300 XCALL(⊂INVERT⊃,⊂(INTEGER E)⊃);
00400 XCALL(⊂EVERT⊃,⊂(INTEGER B)⊃);
00500
00600 XCALL(⊂MKEV⊃,⊂(INTEGER F,V)⊃);
00700 XCALL(⊂MKFE⊃,⊂(INTEGER V1,F,V2)⊃);
00800 XCALL(⊂ESPLIT⊃,⊂(INTEGER E)⊃);
00900
01000 XCALL(⊂KLFE⊃,⊂(INTEGER E)⊃);
01100 XCALL(⊂KLEV⊃,⊂(INTEGER V)⊃);
01200 XCALL(⊂KLVE⊃,⊂(INTEGER E)⊃);
01300
01400 XCALL(⊂MKCOPY⊃,⊂(INTEGER B)⊃);
01500 XCALL(⊂GLUEE⊃,⊂(INTEGER F1,V1,F2,V2)⊃);
01600 XCALL(⊂GLUE⊃,⊂(INTEGER F1,F2)⊃);
01700
01800 XCALL(⊂SWEEP⊃,⊂(INTEGER FCE,FLG)⊃);
01900 XCALL(⊂ROTCOM⊃,⊂(INTEGER F)⊃);
02000 XCALL(⊂PYRAMID⊃,⊂(INTEGER FV)⊃);
02100 XCALL(⊂REMOVF⊃,⊂(INTEGER F)⊃);
02200 XCALL(⊂FVDUAL⊃,⊂(INTEGER B)⊃);
00100 COMMENT EUCLID, IO, VIEWER AND OCCULT;
00200
00300 XCALL(⊂ROTATE⊃,⊂(INTEGER OBJECT,TRAN)⊃);
00400 XCALL(⊂MKTRAN⊃,⊂(INTEGER REFRAM,OPAXCNT;REAL DELTA)⊃);
00500 XCALL(⊂IFORM1⊃,⊂⊃);
00600 XCALL(⊂OFORM1⊃,⊂(INTEGER B)⊃);
00700
00800 XCALL(⊂SHOW1⊃,⊂(INTEGER WINDOW,GLASS)⊃);
00900 XCALL(⊂SHOW2⊃,⊂(INTEGER WINDOW,GLASS)⊃);
01000 XCALL(⊂PROJECTOR⊃,⊂(INTEGER CAMERA,WORLD)⊃);
01100 XCALL(⊂EMARKALL⊃,⊂(INTEGER WORLD)⊃);
01200 XCALL(⊂EMARK⊃,⊂(INTEGER WORLD)⊃);
01300 XCALL(⊂FMARK⊃,⊂(INTEGER WORLD)⊃);
01400 XCALL(⊂OCCULT⊃,⊂(INTEGER WORLD)⊃);
01500
01600 XCALL(⊂KLJUTS⊃,⊂(INTEGER WORLD)⊃);
01700 XCALL(⊂KLJOTS⊃,⊂(INTEGER WORLD)⊃);
01800 XCALL(⊂KLTMPS⊃,⊂(INTEGER WORLD)⊃);
01900 XCALL(⊂CLIPER⊃,⊂(INTEGER WINDOW)⊃);
02000 XCALL(⊂IIIDPY⊃,⊂(INTEGER WINDOW,GLASS)⊃);
02100
02200 XCALL(⊂BIN⊃,⊂(INTEGER B1,B2)⊃);
02300 XCALL(⊂BUN⊃,⊂(INTEGER B1,B2)⊃);
02400 XCALL(⊂BSUB⊃,⊂(INTEGER B1,B2)⊃);